home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / A-COMAL Series / (k)aaj.d64 / src.matrix < prev    next >
Text File  |  2007-02-28  |  4KB  |  301 lines
  1. ;.LIB C64SYB
  2. ARRAY=6
  3. DEFPAG=$46
  4. ENDPRC=$7E
  5. REAL=0
  6. PROC=$70
  7. REF=$75
  8. RUNERR=$C9FB
  9. COPY1=$45
  10. COPY2=$47
  11. COPY3=$49
  12. AC1=$61
  13. AC1M3=$64
  14. AC1M4=$65
  15. INTFP=$C992
  16. FNDPAR=$C896
  17. FPADD=$C8AB
  18. FPINT=$C977
  19. FPMUL=$C8CC
  20. FSBLK=$BE
  21. MYCH=$BF
  22. LDAC1=$C890
  23. POPA1=$C9AA
  24. PUSHA1=$C9BC
  25. STAC1=$C8F6
  26. ;
  27.  .MAC MOVEW
  28.  LDA ?2+1
  29.  LDX ?2
  30.  STA ?1+1
  31.  STX ?1
  32.  .MND
  33. ;
  34.  .MAC DBTOW
  35.  LDA ?2
  36.  LDX ?2+1
  37.  STA ?1+1
  38.  STX ?1
  39.  .MND
  40. ;
  41.  *=$8009 ; START OF MODULE
  42.  .BYTE DEFPAG
  43.  .WORD MODEND
  44.  .WORD SENSER
  45. ; PACKAGE: MATRIX
  46.  .BYTE 6,'MATRIX'
  47.  .WORD PNAME
  48.  .WORD SINIT
  49.  .BYTE 0
  50. ;PROCEDURE NAME TABLE
  51. PNAME .BYTE 7,'MATMULT'
  52.  .WORD PHEAD
  53.  .BYTE 0
  54. ;PROCEDURES:
  55. PHEAD .BYTE PROC
  56.  .WORD MMCODE
  57.  .BYTE 3
  58.  .BYTE REF+ARRAY+REAL,2
  59.  .BYTE REF+ARRAY+REAL,2
  60.  .BYTE REF+ARRAY+REAL,2
  61.  .BYTE ENDPRC
  62. SENSER ; NO SENSING REQ'D
  63. SINIT RTS ; NO INIT. REQ'D
  64. ;RESERVE VARIABLE SPACE
  65. ASTART *=*+2
  66. APOINT *=*+2
  67. BBASE *=*+2
  68. CPOINT=FSBLK ; ZERO PAGE FOR ( ),Y IN INITIALIZING SUMS TO 0.
  69. NTOP *=*+2
  70. ONUM *=*+2
  71. BTOP *=*+2
  72. CTOP *=*+2
  73. BSTART *=*+6
  74. BPOINT=BSTART+2
  75. ;
  76. ;// INDEX RANGE SUBROUTINE
  77. ;
  78. RANGER LDA (COPY1),Y
  79.  SEC
  80.  DEY
  81.  DEY
  82.  SBC (COPY1),Y
  83.  TAX
  84.  INY
  85.  LDA (COPY1),Y
  86.  DEY
  87.  DEY
  88.  SBC (COPY1),Y
  89.  DEY
  90.  RTS
  91. ;
  92. ;// MATMULT
  93. ;
  94. MMCODE CLD
  95.  LDA #1
  96.  JSR FNDPAR ;FIND 1ST ARRAY TABLE
  97.  LDY #10
  98.  JSR RANGER ;GET N-1
  99.  STA NTOP ; N-1
  100.  STX NTOP+1
  101.  JSR RANGER ;GET M-1
  102.  STA CTOP ;TEMP M-1 TIL COMPARE 2ND M-1 VALUE AND TIL COMPUTE CTOP
  103.  STX CTOP+1
  104.  DEY ;SKIP # OF DIMENSIONS
  105.  LDA (COPY1),Y
  106.  STA ASTART
  107.  DEY
  108.  LDA (COPY1),Y
  109.  STA ASTART+1
  110.  LDA #$02
  111.  JSR FNDPAR
  112.  LDY #10
  113.  JSR RANGER ;GET O-1
  114.  STA ONUM ; HI
  115. JP1 STX ONUM+1
  116.  JSR RANGER ;GET 2ND VERSION N
  117.  CPX NTOP+1
  118.  BEQ OK1
  119. ERR64 LDX #64 ;DIMENISION MISMATCH
  120.  JMP RUNERR
  121. OK1 CMP NTOP
  122.  BNE ERR64
  123.  DEY
  124.  LDA (COPY1),Y
  125.  STA BBASE
  126.  DEY
  127.  LDA (COPY1),Y
  128.  STA BBASE+1
  129.  LDA #3
  130.  JSR FNDPAR ;FIND 3RD ARRAY TABLE
  131.  LDY #10
  132.  JSR RANGER ;2ND VERSION OF O-1
  133.  CMP ONUM
  134.  BNE ERR64
  135.  CPX ONUM+1
  136.  BNE ERR64
  137.  INC ONUM+1
  138.  BNE JP2
  139.  INC ONUM
  140. JP2 JSR RANGER ;2ND VERSION OF M
  141.  CPX CTOP+1
  142.  BNE ERR64
  143.  CMP CTOP
  144.  BNE ERR64
  145.  DEY
  146.  LDA (COPY1),Y
  147.  STA CPOINT+1
  148.  DEY
  149.  LDA (COPY1),Y
  150.  STA CPOINT
  151. ;
  152. ;COMPUTE BTOP AND CTOP
  153. ;
  154.  LDA #0
  155.  LDY #5
  156.  JSR INTFP ;5 BYTES PER REAL #
  157.  LDX #<BSTART ;START OF FP # TEMP AREA
  158.  LDY #>BSTART
  159.  JSR STAC1 ;STORE 5
  160.  LDA ONUM
  161.  LDY ONUM+1
  162.  JSR INTFP
  163.  LDA #<BSTART
  164.  LDY #>BSTART
  165.  JSR FPMUL ;5 X ONUM
  166.  JSR PUSHA1
  167.  LDX #<BSTART
  168.  LDY #>BSTART
  169.  JSR STAC1
  170.  JSR POPA1
  171.  JSR FPINT
  172.  LDA AC1M4
  173.  STA ONUM+1 ;LO
  174.  LDA AC1M3
  175.  STA ONUM ;HI
  176.  LDY CTOP+1 ;LO BYTE OF M-1
  177.  INY ;NEED M
  178.  BNE JP3
  179.  INC CTOP
  180. JP3 LDA CTOP
  181.  JSR INTFP
  182.  LDA #<BSTART
  183.  LDY #>BSTART
  184.  JSR FPMUL ;5 X ONUM X M
  185.  JSR FPINT
  186.  LDA AC1M4
  187.  CLC
  188.  ADC CPOINT
  189.  STA CTOP+1
  190.  LDA AC1M3
  191.  ADC CPOINT+1
  192.  STA CTOP ;5 X ONUM X M + 1ST OF ANSWER ARRAY =1ST PAST ANSWER ARRAY
  193. ;DO REST OF BTOP
  194.  LDA NTOP+1 ;LO
  195.  CLC
  196.  ADC #$02
  197.  TAY
  198.  LDA NTOP ;HI
  199.  ADC #$00
  200.  JSR INTFP ; N+1
  201.  LDA #<BSTART
  202.  LDY #>BSTART
  203.  JSR FPMUL ;5 X ONUM X (N+1)
  204.  JSR FPINT
  205.  LDA AC1M4
  206.  CLC
  207.  ADC BBASE+1
  208.  TAY
  209.  LDA BBASE
  210.  ADC AC1M3
  211.  TAX ;5 X ONUM X (N+1) + 1ST OF B ARRAY =1 PAST B ARRAY + A ROW
  212.  TYA
  213.  SEC
  214.  SBC #$05
  215.  STA BTOP+1
  216.  BCS JP4
  217.  DEX
  218. JP4 STX BTOP
  219.  SEC
  220.  SBC ONUM+1
  221.  STA NTOP+1
  222.  TXA
  223.  SBC ONUM
  224.  STA NTOP
  225. ;
  226. ;INITIALIZING DONE. DO MATMULT.
  227. ;
  228. JLOOP MOVEW BSTART:BBASE
  229. KLOOP MOVEW BPOINT:BSTART
  230.  MOVEW APOINT:ASTART
  231.  LDA #0
  232.  TAY
  233.  STA (CPOINT),Y ;ZERO CURRENT ELEMENT OF C(,) BEFORE SUMMING PRODUCTS
  234. LLOOP LDA BPOINT+1 ;LO
  235.  LDY BPOINT ;HI
  236.  JSR LDAC1
  237.  LDA APOINT+1
  238.  LDY APOINT
  239.  JSR FPMUL
  240. ;
  241.  ;ROUND HERE TO DUPLICATE ANSWERS OF PROCEDURE IN COMAL
  242.  LDX <AC1
  243.  LDY >AC1
  244.  JSR $CAA0 ;STORE AC1 AT AC1 TO FORCE ROUNDING
  245.  LDA AC1+1
  246.  ORA #$80
  247.  STA AC1+1 ;FIX WHOLE PART OF MANTISSA-- ALWAYS 1 IN BINARY!
  248.  ;1ST 36 BYTES AT $CAA0 OR SIMILAR COULD BE USED: 23 BYTES LONGER
  249. ;
  250.  LDA CPOINT
  251.  LDY CPOINT+1
  252.  JSR FPADD
  253.  LDX CPOINT
  254.  LDY CPOINT+1
  255.  JSR STAC1
  256.  CLC
  257.  LDA #5
  258.  ADC APOINT+1 ;NEXT ELEMENT OF A(,)
  259.  STA APOINT+1
  260.  BCC JP6
  261.  INC APOINT
  262. JP6 CLC
  263.  LDA BPOINT+1 ;NEXT ELEMENT OF B(,)
  264.  ADC ONUM+1
  265.  STA BPOINT+1
  266.  LDA BPOINT
  267.  ADC ONUM
  268.  STA BPOINT
  269.  LDA NTOP+1
  270.  CMP BPOINT+1
  271.  LDA NTOP
  272.  SBC BPOINT
  273.  BCS LLOOP
  274.  LDA #5
  275.  CLC
  276.  ADC CPOINT
  277.  STA CPOINT
  278.  BCC JP8
  279.  INC CPOINT+1
  280. JP8 LDA CPOINT
  281.  CMP CTOP+1
  282.  LDA CPOINT+1
  283.  SBC CTOP
  284.  BCC JP9
  285.  RTS ;ANSWER ARRAY IS FILLED
  286. JP9 LDA #5
  287.  ADC BSTART+1
  288.  STA BSTART+1
  289.  BCC JP10
  290.  INC BSTART
  291. JP10 LDA BPOINT+1
  292.  CMP BTOP+1
  293.  LDA BPOINT
  294.  SBC BTOP
  295.  BCS JP11
  296.  JMP KLOOP
  297. JP11 MOVEW ASTART:APOINT
  298.  JMP JLOOP
  299. MODEND =*
  300.  .END
  301.